perm filename ACCT[FOO,LMM] blob
sn#077063 filedate 1973-12-07 generic text, type T, neo UTF8
(FILECREATED " 8-SEP-73 12:32:15" ACCT)
(LISPXPRINT (QUOTE ACCTVARS)
T)
(RPAQQ ACCTVARS
((FNS ADDTO DOACCT SETNAMES PRINTAMT SPLIT GETSPLIT DOACCT1
FIXNAME FIXAMT FIXFOR PRINFINAL FIXSPLIT FF FONTSELECT
GETNAMES PRINTENTRIES PRINTSUBTOTALS PRINTSHEET)
[VARS (ACCTDATVARS (QUOTE ((VARS FORS ACCTS NAMES
STANDARDSPLIT)
(PROP SPLIT * FORS]
RUB DOWNARROW))
(DEFINEQ
(ADDTO
[LAMBDA (L N1 N2 V)
(* L is an alist of alists -- insert V under N2
under N1)
(PROG (P Q)
(IF }(P←(ASSOC N1 L NIL))
THEN L← <P← <N1> ! L>)
(IF }(Q←(ASSOC N2 P::1))
THEN (P::1←<Q← <N2> ! P::1>))
(<!! Q V>)
(RETURN L])
(DOACCT
[LAMBDA (INLIST)
(PROG (LIST1 TOTAL FINALIST)
(GETNAMES)
(DOACCT1 INLIST)
(PRINTENTRIES LIST1) (* Now the list looks
like (NAME . AMT))
(FF)
(PRINTSUBTOTALS LIST1)
(INLIST←NIL)
(FOR FORL IN LIST1
DO (FOR NAMEL IN FORL::2
DO INLIST←(ADDTO INLIST NAMEL:1 FORL:1 <'SPENT
NAMEL::1>))
α (FOR NAMEL IN FORL:2
DO INLIST←(ADDTO INLIST NAMEL:1 FORL:1 <'OWE
NAMEL::1>)))
(FOR X IN INLIST DO PRINTSHEET)
(FF)
(PRINFINAL FINALIST)
(RETURN FINALIST])
(SETNAMES
[LAMBDA (L)
NAMES←L])
(PRINTAMT
[LAMBDA (NUM TERPRIFLG)
(PROG (Y)
(SPACES 5-(NCHARS Y←NUM/100))
(PRIN1 Y)
(PRIN1 ".")
(NUM←(IREMAINDER NUM 100))
(IF MINUSP NUM
THEN NUM←-NUM)
(IF NUM LT 10
THEN (PRIN1 "0"))
(PRIN1 NUM)
(IF TERPRIFLG
THEN (TERPRI])
(SPLIT
[LAMBDA (TYPE TOTAL)
(PROG (SPLIT TOT)
(SPLIT←([FIXSPLIT (OR (AND (MEMB TYPE NAMES)
SPLIT← <<TYPE ! 1>>)
(GETP TYPE 'SPLIT)
(PROGN (PRIN1 TYPE T)
(PRIN1 " SPLIT?" T)
(PUT TYPE 'SPLIT (READ T]
OR (HELP "INVALID SPLIT")))
(TOT←0)
(FOR N IN SPLIT DO TOT←TOT+N::1)
(RETURN (FOR N IN SPLIT COLLECT <N:1 ! (TOTAL*N::1+TOT/2)
/TOT>])
(GETSPLIT
[LAMBDA (FOR)
(GETP FOR 'SPLIT])
(DOACCT1
[LAMBDA (INLIST)
(PROG (NAME FOR AMT COMMENTS)
LP [IF INLIST
THEN (IF NAME←(FIXNAME INLIST:1:1) AND FOR←(FIXFOR
INLIST:1:2)
AND AMT←(FIXAMT INLIST:1:3)
THEN COMMENTS←INLIST:1::3
INLIST:1←<NAME FOR (FQUOTIENT AMT 100) !
COMMENTS>
INLIST←INLIST::1
ELSE (PRIN1 "EDIT
" T) INLIST←(CAR (LAST (EDITL <INLIST:1 INLIST> NIL NIL INLIST:1)))
(GO LP))
ELSE (NLSETQ (PROG NIL
NAMLP
(PRIN1 "WHO? " T)
(IF }(NAME←(READ T))
THEN RETURN NIL)
(IF }(FIXNAME NAME)
THEN GO NAMLP)
FORLP
(PRIN1 "FOR? " T)
(FOR←((FIXFOR (READ T))
OR (GO FORLP)))
AMTLP
(PRIN1 "AMT? " T)
(IF }(AMT←(FIXAMT (READ T)))
THEN GO AMTLP)
(CLBUFS)
(PRIN1 "REMARKS? " T)
COMMENTLP
(WHILE (PEEKC T) FMEMB '%
DO (READC T))
(COMMENTS←(READLINE]
(IF }NAME
THEN RETURN LIST1)
(LIST1←(ADDTO LIST1 FOR NAME <AMT ! COMMENTS>))
(GO LP])
(FIXNAME
[LAMBDA (NAME)
(OR (MISSPELLED? NAME 70 NAMES)
(MISSPELLED? (PACK <NAME "≠" >)
70 NAMES)
(AND (PROGN (PRIN1 NAME)
(PRIN1 " NEW PERSON? " T)
(READ T))='Y (CAR (NAMES← <NAME ! NAMES>])
(FIXAMT
[LAMBDA (N)
(AND N←[NUMBERP (CAR (NLSETQ (EVAL N]
(ITIMES N*100])
(FIXFOR
[LAMBDA (FOR)
(OR (MISSPELLED? FOR 70 FORS (FUNCTION GETSPLIT))
(FIXNAME FOR)
(AND [PUT FOR 'SPLIT (PROG (SPLIT)
(PRIN1 FOR)
(PRIN1 " SPLIT? " T)
(SPLIT←(READ T))
(IF SPLIT='-
THEN RETURN STANDARDSPLIT)
(RETURN (FIXSPLIT SPLIT]
(CAR (FORS← <FOR ! FORS>])
(PRINFINAL
[LAMBDA (FL)
(FOR X IN FL DO (PRIN1 X:1) (TAB 30) (PRINTAMT X:2) (TERPRI])
(FIXSPLIT
[LAMBDA (SPLIT)
(AND (LISTP SPLIT)
[EVERY SPLIT (FUNCTION (LAMBDA (X)
(AND (CAR (X:1←(MISSPELLED? X:1 70 NAMES)))
(NUMBERP X::1]
SPLIT])
(FF
[LAMBDA NIL
(PRIN1 "
"])
(FONTSELECT
[LAMBDA (N)
(PRIN1 (CONCAT RUB DOWNARROW (CHARACTER N])
(GETNAMES
[LAMBDA NIL
[OR (LISTP (CAR 'NAMES))
(PROGN (PRIN1 "NAMES? ")
(SETNAMES (READ T]
(IF STRINGP INLIST:1
THEN BILLSDATE←INLIST:1
INLIST←INLIST::1
ELSE (/ATTACH (PROGN (PRIN1 "BILLS FOR (in quotes, please):" T)
(READ T))
INLIST)
INLIST←INLIST::1])
(PRINTENTRIES
[LAMBDA (LIST1)
(FOR FORL IN LIST1 DO (* For each for type,
for each person, add up
the totals SPENT)
(FOR NAMEL IN FORL::1
DO (TERPRI) (PRIN1 NAMEL:1) (PRIN1
" ----> ")
(PRIN1 (OR (GETP FORL:1 'NAME)
FORL:1))
TOTAL←0
(FOR AD IN NAMEL::1
DO (TERPRI)
(FOR X IN AD::1
DO (PRIN1 X) (SPACES 1))
(TAB 41)
(PRINTAMT AD:1) TOTAL←TOTAL+AD:1)
(TAB 41)
(PRIN1 "--------")
(TAB 41)
(PRINTAMT TOTAL T) NAMEL::1←TOTAL])
(PRINTSUBTOTALS
[LAMBDA (LIST1)
(FOR FORL IN LIST1 DO TOTAL←0
(IF FORL::2=NIL
THEN TOTAL←FORL:2::1
ELSE (PRIN1 FORL:1) (PRIN1 ":
") (FOR NAMEL IN FORL::1 DO (PRIN1 NAMEL:1) TOTAL←TOTAL+NAMEL::1
(TAB 20)
(PRINTAMT NAMEL::1 T))
(PRIN1 " -------------
")
(TAB 20)
(PRINTAMT TOTAL T)
(TERPRI))
FORL::1← <(SPLIT FORL:1 TOTAL)
! FORL::1>])
(PRINTSHEET
[LAMBDA (NAME.ENTRIES)
(PROG ((OWE 0)
(SPENT 0))
(FF)
(FONTSELECT 1)
(PRIN1 " The Alameda House")
(RPTQ 4 (TERPRI))
(FONTSELECT 4)
(PRIN1 "Statement for ")
(PRIN1 BILLSDATE)
(RPTQ 4 (TERPRI))
(FONTSELECT 3)
(PRIN1 NAME.ENTRIES:1)
(PRIN1 ":")
(FONTSELECT 0)
(TERPRI)
(FOR FORL IN NAME.ENTRIES::1 DO (SPACES 1) (PRIN1 FORL:1)
(IF TEM←(ASSOC 'SPENT FORL::1)
THEN (TAB 10)
(PRINTAMT TEM:2)
SPENT←SPENT+TEM:2)
(IF TEM←(ASSOC 'OWE FORL::1)
THEN (TAB 30)
(PRINTAMT TEM:2)
OWE←OWE+TEM:2)
(TERPRI))
(TAB 10)
(PRIN1 "--------")
(TAB 30)
(PRIN1 "---------")
(TERPRI)
(TAB 4)
(PRIN1 "SPENT")
(TAB 10)
(PRINTAMT SPENT)
(TAB 24)
(PRIN1 "OWE")
(TAB 30)
(PRINTAMT OWE)
(PRIN1 " NET:")
(PRINTAMT OWE-SPENT T)
(FINALIST← <<NAME.ENTRIES:1 OWE-SPENT> ! FINALIST>])
)
(RPAQQ ACCTDATVARS ((VARS FORS ACCTS NAMES STANDARDSPLIT)
(PROP SPLIT * FORS)))
(RPAQQ RUB ␈)
(RPAQQ DOWNARROW ↓)
STOP